Housing Justice - Rent Exploitation
Sokona Mangane
2022-07-06
We downloaded data from Census.gov using the get_acs function, did some data wrangling and cleaning, wrote them as a csv file so that we can import them into RMarkdown
#code_folding: "hide" (hides the code but ppl can see the code if they want to)
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE) #doesn't show the messages or the warings, only code output, must be its in own code chunk to apply to all the subsequent ones#importing data
library(readr)
library(tidycensus)
library(tidyverse)
library(tigris)
library(leaflet)
library(sf)
library(DT)
ACS_Housing_Data <- read_csv("Housing_Data.csv")
Income_By_Tenure <- read_csv("Income_By_Tenure.csv")
Tenure <- read_csv("Tenure.csv")
Tenure_By_Income <- read_csv("Tenure_By_Income.csv")
Tenure_By_Race <- read_csv("Tenurebyrace.csv")
Poverty_By_Race <- read_csv("PovertyByRace.csv")Basic summary statistics:
How many renters are there in each county? of which demographics?
Petersburg, Hopewell, Charlottesville and Richmond have the highest percentage of renters.
# Tenure <- Tenure[, 3:9]
# Tenure <- full_join(Tenure, Tenure_By_Race, by = "County_fips")
Tenure_By_Race_Perc <- Tenure_By_Race %>%
mutate(Perc_rentersE = (RentersE/Total_OccupantsE), Perc_ownersE = (OwnersE/Total_OccupantsE)) %>%
group_by(County) %>%
summarize(Renters = median(Perc_rentersE, na.rm = TRUE), Owners = median(Perc_ownersE, na.rm = TRUE), White_Renters = median((White_rentersE/RentersE), na.rm = TRUE), White_Owners = median((White_ownersE/OwnersE), na.rm = TRUE), Black_Renters = median((Black_rentersE/RentersE), na.rm = TRUE), Black_Owners = median((Black_ownersE/OwnersE), na.rm = TRUE), NativeAm_Owners = median((NativeAm_ownersE/OwnersE), na.rm = TRUE), NativeAm_Renters = median((NativeAm_rentersE/RentersE), na.rm = TRUE), Asian_Owners = median((Asian_ownersE/OwnersE), na.rm = TRUE), Asian_Renters = median((Asian_rentersE/RentersE), na.rm = TRUE), PacificIslander_Owners = median((PacificIslander_ownerE/OwnersE), na.rm = TRUE), PacificIslander_Renters = median((PacificIslander_renterE/RentersE), na.rm = TRUE), HispanicLatino_Owners = median((HispanicLatino_ownerE/OwnersE), na.rm = TRUE), HispanicLatino_Renters = median((HispanicLation_renterE/RentersE), na.rm = TRUE)) %>%
mutate(across(c(2:14), scales::percent)) %>%
arrange(desc(Renters)) %>%
select(1:3,4,6,9,11,13,15,5,7,8,10,12,14)
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'County'),
th(colspan = 6, 'Renters'),
th(colspan = 6, 'Owners')
),
tr(
lapply(rep(c('White_Renters', 'Black_Renters', 'NativeAm_Renters', 'Asian_Renters', "PacificIslander_Renters", "HispanicLatino_Renters", 'White_Owners', 'Black_Owners', 'NativeAm_Owners', 'Asian_Owners', "PacificIslander_Owners", "HispanicLatino_Owners"), 2), th)
)
)
))
DT_Tenure_By_Race <- Tenure_By_Race_Perc[,c(1,4:15)]
datatable(DT_Tenure_By_Race,
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: center;',
'Table 1: ', htmltools::em('Median Percentage of Renters and Owners in Each County (by Demographics)')),
container = sketch,
rownames = FALSE,
extensions = 'Buttons',
options = list(dom='Bfrtip',
buttons=c('copy', 'csv', 'excel', 'print', 'pdf')
)
)Tenure_perc_by_race <- Tenure_By_Race %>%
mutate(Perc_WRenters = (White_rentersE/RentersE), Perc_WOwners = (White_ownersE/OwnersE), Perc_BRenters = (Black_rentersE/RentersE), Perc_BOwners = (Black_ownersE/OwnersE), Perc_NativeAmOwners = (NativeAm_ownersE/OwnersE), Perc_NativeAmRenters = (NativeAm_rentersE/RentersE), Perc_AsianOwners = (Asian_ownersE/OwnersE), Perc_AsianRenters = (Asian_rentersE/RentersE), Perc_PacificIslanderOwner = (PacificIslander_ownerE/OwnersE), Perc_PacificIslanderRenter = (PacificIslander_renterE/RentersE), Perc_HispanicLatinoOwner = (HispanicLatino_ownerE/OwnersE), Perc_HispanicLationRenterE = (HispanicLation_renterE/RentersE)) %>%
select(1:5, 48:59)
Tenure_perc_by_race <- Tenure_perc_by_race %>%
pivot_longer(., cols = c(Perc_AsianOwners, Perc_WRenters, Perc_WOwners, Perc_BOwners, Perc_BRenters, Perc_NativeAmOwners, Perc_NativeAmRenters, Perc_AsianRenters, Perc_PacificIslanderOwner, Perc_PacificIslanderRenter, Perc_HispanicLatinoOwner, Perc_HispanicLationRenterE), names_to = "Variable", values_to = "Percentage (Estimated)") %>%
mutate(Race = case_when(
str_detect(Variable, "Asian") ~ "Asian",
str_detect(Variable, "B") ~ "Black",
str_detect(Variable, "NativeAm") ~ "Native American",
str_detect(Variable, "PacificIslander") ~ "Pacific Islander",
str_detect(Variable, "Hispanic") ~ "Hispanic or Latino",
str_detect(Variable, "WRenters") ~ "White",
str_detect(Variable, "WOwners") ~ "White"
),
Variable = case_when(
str_detect(Variable, "Owner") ~ "Owner",
str_detect(Variable, "Renter") ~ "Renter"
))
Tenure_perc_by_race <- rename(Tenure_perc_by_race, Tenure_Type = Variable)
Tenure_perc_by_race$`Percentage (Estimated)` <- round(Tenure_perc_by_race$`Percentage (Estimated)`, 3)
Tenure_perc_by_race %>%
ggplot(aes(x = Tenure_Type, y = `Percentage (Estimated)`)) +
geom_boxplot() +
facet_wrap(~Race)
#Same graph different output
Tenure_perc_by_race %>%
ggplot(aes(x = Tenure_Type, y = `Percentage (Estimated)`, fill = Race)) +
geom_boxplot() +
facet_wrap(~County) #much easier to see without this funcdtion, but jsut for comparison purposes
relationship between demographics of renters and rent expoitation?
Tenure_and_Housing_Data <- full_join(Tenure_perc_by_race, ACS_Housing_Data, by = "GEOID") %>%
select(1,6:30)
Tenure_and_Housing_Data %>%
filter(Tenure_Type == "Renter") %>%
ggplot(aes(x = `Percentage (Estimated)`, y = RentTaxRatio, color = Tenure_Type)) +
geom_smooth() +
facet_wrap(~Race)
#ask for better way to visualize this What is the average rent, income, and real estate taxes paid in each County?
Highest rent: Fluvanna, Chesterfield, Henrico and Albemarle Highest median real estate taxes: Albemare, Charlottesville, Richmond, and Chesterfeild
ACS_Housing_Data |>
group_by(County) |>
summarize(Median_rent = median(MedianRentE, na.rm = TRUE), Median_tax = median(MedianTaxesE, na.rm = TRUE), Median_income = median(MedianIncomeE, na.rm = TRUE))## # A tibble: 11 × 4
## County Median_rent Median_tax Median_income
## <chr> <dbl> <dbl> <dbl>
## 1 Albemarle 1323 2657 55964
## 2 Charlottesville 1181 2622. 40104
## 3 Chesterfield 1333 1935 60040
## 4 Fluvanna 1419 1786 49581
## 5 Greene 974. 1636. 51240.
## 6 Henrico 1214 1923 53133
## 7 Hopewell 910. 1104. 28625
## 8 Louisa 875 1432 46964
## 9 Nelson 918. 1357 44754
## 10 Petersburg City 952 1067 34167
## 11 Richmond City 1085 2148 37975Census Tract 4.01 - Friendship Court
Census Tract 6 - Bice House
What is the average rent to tax ratio in each county?
Highest Rent Tax Ratio: Petersburg City, Chesterfeild, and Nelson
ACS_Housing_Data$RentTaxRatio <- round(ACS_Housing_Data$RentTaxRatio, 3)
ACS_Housing_Data %>%
group_by(County) %>%
summarize(Median_Rent_Tax_RaTio = median(RentTaxRatio, na.rm = TRUE))## # A tibble: 11 × 2
## County Median_Rent_Tax_RaTio
## <chr> <dbl>
## 1 Albemarle 0.542
## 2 Charlottesville 0.432
## 3 Chesterfield 0.719
## 4 Fluvanna 0.694
## 5 Greene 0.62
## 6 Henrico 0.659
## 7 Hopewell 0.845
## 8 Louisa 0.644
## 9 Nelson 0.71
## 10 Petersburg City 0.768
## 11 Richmond City 0.484What is the average percent of rent of income in each county? Thus, which county is the most rent burdened?
Richmond, Charlottesville and Nelson are the most rent burdened counties, but no counties appear to be severly rent burdened (more than 50), on average.
ACS_Housing_Data %>%
group_by(County) %>%
summarize(Median_perc_rent_income = median(PercRentBurdenE, na.rm = TRUE)) %>%
arrange(desc(Median_perc_rent_income))## # A tibble: 11 × 2
## County Median_perc_rent_income
## <chr> <dbl>
## 1 Richmond City 32.6
## 2 Charlottesville 31.9
## 3 Hopewell 31.4
## 4 Henrico 28.6
## 5 Albemarle 27.9
## 6 Petersburg City 27.8
## 7 Chesterfield 27.5
## 8 Greene 27
## 9 Louisa 26.6
## 10 Nelson 23.8
## 11 Fluvanna 21.3Here is a more detailed look at who’s rent burded and severely rent burdened in each County, with Richmond still being the most rent burdened.
ACS_Housing_Data <- ACS_Housing_Data %>%
mutate(Rent_Burdened = case_when(
PercRentBurdenE >= 30 & PercRentBurdenE < 50 ~ "Yes",
PercRentBurdenE >= 50 ~"Yes, Severely",
TRUE ~ "No")
)
ACS_Housing_Data %>%
group_by(Rent_Burdened, County) %>%
summarize(Percent = round((n()/317)*100, 3))## # A tibble: 25 × 3
## # Groups: Rent_Burdened [3]
## Rent_Burdened County Percent
## <chr> <chr> <dbl>
## 1 No Albemarle 5.68
## 2 No Charlottesville 1.58
## 3 No Chesterfield 15.8
## 4 No Fluvanna 1.26
## 5 No Greene 1.26
## 6 No Henrico 16.4
## 7 No Hopewell 1.26
## 8 No Louisa 1.89
## 9 No Nelson 1.26
## 10 No Petersburg City 2.21
## # … with 15 more rowsAs we can see here, alhtough it may not look like it from the numbers above, a lot of counties (the biggest census tracts too) are rent burdened, some even severely.
counties <- c("Albemarle", "Charlottesville", "Fluvanna", "Greene", "Louisa", "Nelson", "Richmond city", "Henrico", "Chesterfield", "Hopewell", "Petersburg")
countytracts <- tracts(state = "VA", county = counties, year = 2020)##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%countytracts <- countytracts |>
mutate(GEOID = as.numeric(countytracts$GEOID))
HousingDataSpatial <- full_join(ACS_Housing_Data, countytracts, by = "GEOID") |>
sf::st_as_sf() |>
mutate(INTPTLAT = as.numeric(countytracts$INTPTLAT), INTPTLON = as.numeric(countytracts$INTPTLON))|>
sf::st_transform(crs = '+proj=longlat +datum=WGS84') #one way to reference a CRS, another way (which Claibourne used) is cvl_rents <- st_transform(cvl_rents, 4326) because leaflet expects the crs to be 4326
pal1 <- colorNumeric("YlOrRd", HousingDataSpatial$PercRentBurdenE, reverse = TRUE)
HousingDataSpatial %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillOpacity = 0.1,
weight = 2) %>%
addPolygons(stroke = FALSE, fillOpacity = 0.8,
smoothFactor = 0.5,
color = ~pal1(PercRentBurdenE),
label = ~PercRentBurdenE,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", HousingDataSpatial$County, "<br>",
"Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
"Percentage of Rent Burden: ", HousingDataSpatial$RentTaxRatio)) %>%
addLegend(pal = pal1,
values = ~PercRentBurdenE,
opacity = 0.7,
title = "Percentage of Rent Burden (2020)",
position = "bottomleft") # #%>%
# addLabelOnlyMarkers(lng = ~INTPTLON, lat = ~INTPTLAT, label = ~NAME.y,
# labelOptions = labelOptions(noHide = TRUE)) %>% #labels census tracts
#to add hovering functionality check what she put for the highlight argument and to add popups, check what she put for the popup argumentrelationship between demographics of renters and being rent burndened?
Tenure_and_Housing_Data %>%
filter(Tenure_Type == "Renter") %>%
ggplot(aes(x = `Percentage (Estimated)`, y = PercRentBurdenE, color = Tenure_Type)) +
geom_smooth() +
facet_wrap(~Race)
#relationship btw those who are rent burdened and rent tax ratio?
Tenure_and_Housing_Data %>%
ggplot(aes(x = PercRentBurdenE, y = RentTaxRatio)) +
geom_smooth() +
facet_wrap(~County.y)
#????What does the income and ratio look like there?
Although these three are the most rent burdened, it isn’t obvious based on its rent to tax ratio and median household income, except for in Nelson county (which only has 5 observations in the tract)
- Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
- Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.4325
- Nelson: Median Income is $53,579 and the Rent to Tax Ratio is 0.71
How many are below the poverty level in this County? and which demographics?
We can reach the same conclusions here, with Richmond having the third highest percentage of those below the poverty level.
- Richmond: On average, 17.6% of the county is below the poverty level
and people who are Black and Asian have the highest average percent of
those below the poverty level.
- Charlottesville: On average, 15.3% of the county is below the
poverty level and people who are Hispanic or Latino and Asian have the
highest average percent of those below the poverty level.
- Nelson: On average, 12.9% of the county is below the poverty level and people who are Asian have the highest average percent of those below the poverty level (50%).
What is the income distribution in this census tract look like?
Which county has the most students (includes Undergraduate and Graduate students)?
No one county has a disproportionate amount of students compared to the other, however, Richmond, Charlottesville, and Henrico have the highest student populations
ACS_Housing_Data %>%
group_by(County) %>%
summarize(Median_perc_students = median(Perc_StudentsE, na.rm = TRUE))## # A tibble: 11 × 2
## County Median_perc_students
## <chr> <dbl>
## 1 Albemarle 5.21
## 2 Charlottesville 5.98
## 3 Chesterfield 5.43
## 4 Fluvanna 4.96
## 5 Greene 3.16
## 6 Henrico 5.59
## 7 Hopewell 4.84
## 8 Louisa 3.7
## 9 Nelson 4.96
## 10 Petersburg City 4.8
## 11 Richmond City 6.59*More than 50% of pop. in tracts in Richmond and Charlottesville city consist of students, but doesn’t seem like the case for Henrico!
pal <- colorNumeric("YlOrRd", HousingDataSpatial$Perc_StudentsE, reverse = TRUE) #the reverse argument reverses the color palette
#pal1 <- colorNumeric("Greens", domain = HousingDataSpatial$County, HousingDataSpatial$County)
#creating map and adding layers
perc_student_counties <- c("Richmond City", "Charlottesville", "Henrico")
HousingDataSpatial %>%
filter(County %in% perc_student_counties) %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillOpacity = 0.1,
weight = 2) %>%
addLabelOnlyMarkers(lng = ~INTPTLON, lat = ~INTPTLAT, label = ~NAME.y,
labelOptions = labelOptions(noHide = TRUE)) %>% #labels census tracts
addPolygons(stroke = FALSE, fillOpacity = 0.8,
smoothFactor = 0.5,
color = ~pal(Perc_StudentsE),
label = ~Perc_StudentsE,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T)) %>% #to add hovering functionality check what she put for the highlight argument and to add popups, check what she put for the popup argument
addLegend(pal = pal,
values = ~Perc_StudentsE,
opacity = 0.7,
title = "Highest Percentage of Students in Charlottesville and Richmond regions for 2020",
position = "bottomleft")#ask soumya/claibourne why census tracts that aren't shaded ar being shown (esp since I filtered the dataframe)*Can see that Henrico Coutny has quite a few tracts with more than 10% of students and one with more than 15%, but it doesn’t compare to the major cities in VA
HousingDataSpatial %>%
filter(County == "Henrico") %>%
ggplot(aes(x = NAME.y, y = Perc_StudentsE)) +
geom_col() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
What does the income, and ratio look like there?
- Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
- Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.433
- Henrico: Median Income is $69,827 and the Rent to Tax Ratio is 0.659
What are the income distributions in each census tract?
What’s considered low-income is dependent on the cost of living of that location, thus, we used the HUD’s measure of Low-Income in Chartlottesville and Richmond as our threshold as well. Below is the Median Family Income for these cities and the definitions used by the HUD.
- Low-Income: “The calculation normally used, therefore, is to set the
4-person low-income limit at 1.6 (i.e. 80%/50%) times the relevant
4-person very low income limit”
- Very Low-Income: “The 4-person Very Low-Income Limit (VLIL) is based on 50% of the median family income estimated for the Charlottesville, VA MSA.”
- Extremely Low-Income: “The FY 2014 Consolidated Appropriations Act changed the definition of extremely low-income to be the greater of 30/50ths (60 percent) of the Section 8 very low-income limit or the poverty guideline as established by the Department of Health and Human Services (HHS), provided that this amount is not greater than the Section 8 50% very low-income limit.”
The numbers on the site are after they’ve done their adjustments. We also looked at the [national poverty thresholds set by the Census Bureau] (https://www.census.gov/data/tables/time-series/demo/income-poverty/historical-poverty-thresholds.html). Both websites have poverty levels depending on the family size. The Census Bureau also accounted for the number of children, whereas the HUD sets these thresholds based on the houshold occupancy. Therefore, we looked at the Average Household Size Data Table and calculated the Average in the counties we were looking at (Richmond: 2.5 and Chartlottesville: 2.34). We used the thresdolds for a family of 2.5 people (with no children). According to the Census Bureau, the weight average poverty thresholds for a family of 2.5 people is $18,662, which is way below the extremely low-income limits in Charlottesville and Richmond.
(also include how you had to work iwht the categories already set by the cenus bureau, also note that the median for Charlottesville MSA excludes Louisa county)
Richmond
Median Family Income: $101,000
Charlottesville
Median Family Income: $111,200
# Above_median <- c("Renter occupied: $>150k", "Renter occupied: $100k to $149,999", "Owner occupied: $>150k", "Owner occupied: $100k to $149,999")
# lowincome <- c("Renter occupied: $50k to $74,999", "Owner occupied: $50k to $74,999")
# very_lowincome <- c("Renter occupied: $35k to $49,999", "Owner occupied: $35k to $49,999")
# extremely_lowincome <- c("Renter occupied: $25k to $34,999", "Renter occupied: $20k to $24,999", "Owner occupied: $25k to $34,999", "Owner occupied: $20k to $24,999")
# below_avgpovertylvl <- c("Renter occupied: $15k to $19,999", "Renter occupied: $10k to $14,999", "Renter occupied: $5k to $9,999", "Renter occupied: <$5k", "Owner occupied: $15k to $19,999", "Owner occupied: $10k to $14,999", "Owner occupied: $5k to $9,999", "Owner occupied: <$5k")
#
#
# Tenure_By_Income <- Tenure_By_Income %>%
# mutate(Income_Level = case_when(
# Variable %in% Above_median ~ "Above Med Family Income",
# Variable %in% lowincome ~ "Low Income",
# Variable %in% very_lowincome ~ "Very Low Income",
# Variable %in% extremely_lowincome ~ "Extremely Low Income",
# Variable %in% below_avgpovertylvl ~ "Below National Avg. Poverty Level")) %>%
# mutate(Income_Level = case_when(
# County == "Louisa" ~ NA,
# ))
#
#
# Tenure_By_Income %>%
# for (i in len(Tenure_By_Income)) {
# if(County_fips == 109){
# mutate(Income_Level = NA)
# } else{
# mutate(Income_Level = case_when(
# Variable %in% Above_median ~ "Above Med Family Income",
# Variable %in% lowincome ~ "Low Income",
# Variable %in% very_lowincome ~ "Very Low Income",
# Variable %in% extremely_lowincome ~ "Extremely Low Income",
# Variable %in% below_avgpovertylvl ~ "Below National Avg. Poverty Level")
# )
# }
# }
# TenureByIncome %>%
# ggplot(aes(x = Income_Level, fill = County)) +
# geom_bar()How does this compare to the average gini index and who’s below poverty in each county?
Poverty_By_Race %>%
group_by(County) %>%
summarize(Median_perc_below_poverty = median(Perc_Total_BelowPovertyE, na.rm = TRUE), Median_Gini_Index = median(Gini_IndexE, na.rm = TRUE))## # A tibble: 11 × 3
## County Median_perc_below_poverty Median_Gini_Index
## <chr> <dbl> <dbl>
## 1 Albemarle 5.71 0.428
## 2 Charlottesville 15.3 0.480
## 3 Chesterfield 5.39 0.356
## 4 Fluvanna 3.76 0.407
## 5 Greene 9.22 0.390
## 6 Henrico 7.54 0.394
## 7 Hopewell 27.8 0.439
## 8 Louisa 10.6 0.426
## 9 Nelson 12.9 0.452
## 10 Petersburg City 22.1 0.437
## 11 Richmond City 17.7 0.448Poverty_By_Race %>%
ggplot(aes(x = Perc_Total_BelowPovertyE, y = Gini_IndexE)) +
geom_point() +
facet_wrap(~County)
Which demographics are most likely to be below poverty and above (or at) in each county?
PovertyBy_Race_County <- Poverty_By_Race %>%
group_by(County) %>%
summarize(Median_Perc_WBelowPoverty = median((Perc_BelowPoverty_WhiteE), na.rm = TRUE), Median_Perc_BBelowPoverty = median((Perc_BelowPoverty_BlackE), na.rm = TRUE), Median_Perc_NativeAm_BelowPoverty = median((Perc_BelowPoverty_NativeAmE), na.rm = TRUE), Median_Perc_Asian_BelowPoverty = median((Perc_BelowPoverty_AsianE), na.rm = TRUE), Median_Perc_PacificIslander_BelowPoverty = median((Perc_BelowPoverty_PacificIslanderE), na.rm = TRUE), Median_Perc_HispanicLatino_BelowPoverty = median((Perc_BelowPoverty_HispanicLatinoE), na.rm = TRUE))
PovertyBy_Race_County## # A tibble: 11 × 7
## County Median_Perc_WBe… Median_Perc_BBe… Median_Perc_Nat… Median_Perc_Asi…
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Albemarle 5.67 0.84 0 0
## 2 Charlott… 11.0 14.6 0 19.5
## 3 Chesterf… 4.14 5.32 0 0
## 4 Fluvanna 3.73 3.69 0 0
## 5 Greene 6.60 9.34 0 2.38
## 6 Henrico 5.86 7.08 0 0
## 7 Hopewell 20.8 33.0 0 0
## 8 Louisa 9 20.7 0 0
## 9 Nelson 4.5 2.75 NA 50
## 10 Petersbu… 12.1 23 47.2 8.74
## 11 Richmond… 9.2 24.7 0 26.9
## # … with 2 more variables: Median_Perc_PacificIslander_BelowPoverty <dbl>,
## # Median_Perc_HispanicLatino_BelowPoverty <dbl>#graph! #Relationship btw those who are rent burdended and gini index?
Plots from Previous RMarkdown on distribution
#distrubtion of the rent tax ratio as a whole
ACS_Housing_Data %>%
ggplot(aes(ACS_Housing_Data$RentTaxRatio)) +
geom_histogram()
#distrubtion of the rent tax ratio by county
ACS_Housing_Data %>%
ggplot(aes(ACS_Housing_Data$RentTaxRatio)) +
geom_histogram() +
facet_wrap(~County)
#distrubtion of the rent tax ratio by county (boxplot)
ACS_Housing_Data |>
ggplot() +
aes(x = County, y = RentTaxRatio) +
geom_boxplot() 